Amiga Format CD 12/Amiga Format AFCD12 (Apr 1997, Issue 96).iso/-in_the_mag-/html_tutorial/cgi_pars.ada

Text File | 1997-01-21 | 6KB | 205 lines

-------------------------------------------------------------
-- (C) Michael A Smith 1995-1996                           --
--     Additional material about Ada 95                    --
--     See http://www.brighton.ac.uk/ada95/home.html       --
-------------------------------------------------------------

--(class_description.ADS) Implementation Instantiation

--
-- Split the components of a CGI result string into
--  individual sub strings
--
-- For example the string
--   name=Your+name&action=%2B10%25&log=~mas/log
--
-- is composed of three named elements:
--
--     Element    String associated with element
--     name       Your name
--     action     +10%
--     log        /usr/staff/mas/log
--
-- (C) M.A.Smith University of Brighton
-- Permission is granted to use this code
--   provided this declaration and copyright notice remains intact.
-- 4 January 1996
--
--
--
-- S p e c i f i c a t i o n


with Simple_io, Ada.Strings.Unbounded;
use  Simple_io, Ada.Strings.Unbounded;
package Class_parse is
  type Parse is private;
  procedure set( the:in out Parse; mes:in String );
  function  get_item( the:in Parse; key: in String; pos:in Integer:=1;
                     map:in Boolean :=false ) return String;
private
  SEP : constant Character := '&';
  type Parse is record
    str : Unbounded_string;            -- String to parse
    len : Integer;                     -- Length
  end record;
end Class_parse;



--
-- Split the components of a CGI result string into
--  individual sub strings
--
-- For example the string
--   name=Your+name&action=%2B10%25&log=~mas/log
--
-- is composed of three named elements:
--
--     Element    String associated with element
--     name       Your name
--     action     +10%
--     log        /usr/staff/mas/log
--
-- (C) M.A.Smith University of Brighton
-- Permission is granted to use this code
--   provided this declaration and copyright notice remains intact.
-- 4 January 1996
--
--
-- I m p l e m e n t a t i o n

package body Class_parse is

function remove_escape(from:in String) return String;
function hex( first, second :in Character ) return Character;

procedure set( the:in out Parse; mes:in String ) is
begin
  the.str := to_unbounded_string(mes);
  the.len := mes'Length;
end set;

function get_item( the:in Parse; key: in String; pos:in Integer:=1;
                   map:in Boolean :=false ) return String is
  cur_tag   : Integer := 1;
  i,j       : Integer;
  start     : Integer;
  parse_str : String (1 .. the.len) := to_string( the.str );
begin
  i := 1;
  while i < the.len-key'Length loop
    if parse_str(i .. i+key'Length-1) = key then
      if parse_str(i+key'Length) = '=' then
        if cur_tag = pos then
          start := i+key'Length+1; j := start;
          while j <= the.len and then parse_str(j) /= SEP loop
            if j <= the.len then j := j + 1; end if;
          end loop;
          return remove_escape( parse_str( start .. j-1 ) );
        else
          cur_tag := cur_tag + 1;
        end if;
      end if;
    end if;
    i := i + 1;
  end loop;
  return "";
end get_item;

function remove_escape(from:in String) return String is
  res : String( 1 .. from'Length );
  ch  : Character;
  i,j : Integer;
begin
  i := from'First; j := 0;
  while i <= from'Last loop
    ch := from(i);
    case ch is
      when '%' =>
    ch := hex(from(i+1), from(i+2) );
        i:= i+2;
      when '+' =>
    ch := ' ';
      when others =>
        null;
    end case;
    i := i + 1;
    j := j + 1; res(j) := ch;
  end loop;
  return res(1..j);
end remove_escape;

function hex( first, second :in Character ) return Character is
  type Mod256 is mod 256;
  a_ch : Mod256;
  function hex_value( ch:in Character ) return Mod256 is
  begin
    if ch in '0' .. '9' then
      return Character'Pos(ch)-Character'Pos('0');
    end if;
    if ch in 'A' .. 'F' then
      return Character'Pos(ch)-Character'Pos('A')+10;
    end if;
    return 0;
  end hex_value;
begin
  return Character'Val(
        ( hex_value(first) and 16#FF#) * 16 +
        ( hex_value(second) and 16#FF#) );
end hex;

end Class_parse;

package unix_if is
  function get_env( str:in String ) return String;
end unix_if;

with Interfaces.C, Interfaces.C.Strings;
use  Interfaces.C, Interfaces.C.Strings;
package body unix_if is

function get_env( str:in String ) return String is
  function getenv( str:in Char_array ) return Chars_ptr;
  pragma import (C, getenv, "getenv");
  res : Chars_ptr;
begin
  res := getenv( to_c( str, append_nul=>TRUE ) );
  if res = NULL_PTR then
    return "";
  else
    return value(res);
  end if;
end get_env;

end unix_if;

with Simple_io, Class_parse, unix_if, Ada.Strings.Unbounded;
use  Simple_io, Class_parse, unix_if, Ada.Strings.Unbounded;
procedure main is
  list         : Parse;
  query_string : Unbounded_string;      -- String to parse

begin
  query_string := to_unbounded_string( get_env( "QUERY_STRING" ) );
  if ( to_string( query_string ) = "" ) then
    query_string := to_unbounded_string(
        "tag=one&"             &
        "name=mike&"           &
        "action=%2B10%25&"     &
        "tag=two&"             &
        "log=~mas/log&"        &
        "tag=three" );
  end if;

  set( list, to_string(query_string) ) ;

  put("name   = "); put( get_item( list, "name" )) ; new_line;
  put("action = "); put( get_item( list, "action" )) ; new_line;
  put("log    = "); put( get_item( list, "log" )) ; new_line;
  for i in 1 .. 4 loop
    put("tag(" ); put( i, width=>1 ); put( ")  ");
    put( get_item( list, "tag", i ) ); new_line;
  end loop;
end main;